perm filename QUADS.SAI[PUB,TES]1 blob
sn#129306 filedate 1974-11-03 generic text, type T, neo UTF8
00100 BEGOF("QUADS")
00200
00300
00400 COMMENT
00500
00600 Tabs, somescripts, infinity, superimpose, flush left, flush right,
00700 and center. Also the INDENT declaration.
00800
00900 ;
01000
01100 INTEGER XLBFAKE; RKJ: FOR FORWARD REFERENCES IN BOUNDED ITEMS ;
01200
01300 PROCEDURES
00100 PUBLIC SIMPLE PROCEDURE QUADS! ;$"#
00200 BEGIN "QUADS!"
00300 TABSORT[1]←TWO(33);
00400 END "QUADS!" ;
00100 PUBLIC RECURSIVE PROCEDURE BOUND(INTEGER KIND) ;$"#
00200 IF ON THEN
00300 BEGIN
00400 INTEGER LB, RB, DEST, FILLIN, XLB, XFILLIN ;
00500 INTEGER INFLB, INFRB ; RKJ: 1-8-74;
00600 LABEL SLIDEFILL, TABFILL, TABCASE ; STRING FILLER, BOUNDS ;
00700 STRING SEGMENT ;
00800 COMMENT KIND LEQ 0 ... ∞X (The ASCII of X negated)
00900 = 1 ... ←
01000 = 2 ... →
01100 = 3 ... CR or BREAK
01200 = 4 ... Tab (\ or ∂) ;
01300 IF KIND=3 OR KIND=4 AND NULSTR(LBF) THEN SPCS ← 0 ELSE EMIT(NULL) ;
01400 OKCR(TRUE) ; comment added 4/17/72 ;
01500 Comment An earlier BOUND on this line may have set LBK←KIND ;
01600 IF LBK < 3 THEN CASE LBK MAX 0 OF
01700 BEGIN COMMENT BY KIND ;
01800 COMMENT LEQ 0 ... ∞ Only valid if immediately preceding this Bound ;
01900 IF LBO < OAKS OR SPCS THEN
02000 BEGIN
02100 WARN("=","∞ needs a right bound") ;
02200 LBF ← NULL ;
02300 END ;
02400 COMMENT = 1 ... ← Center between left bound at POSN=LBP and this TAB to RBOUND, or between margins ;
02500 BEGIN "CENTER"
02600 IF KIND=4 THEN BEGIN XLB←XLBP ; LB←LBP ; RB←RBOUND END
02700 ELSE BEGIN LB←XLB←0 ; RB←RMARG-LMARG END ;
02800 BOUNDS ← CVSR(INFRB←(LMARG+RB)*(IF XCRIBL THEN CHARW ELSE 1)) & CVSR(INFLB←(LMARG+LBP-LB)*(IF XCRIBL THEN CHARW ELSE 1));
02900 FILLIN ← ((RB - POSN) - (LBP - LB)) DIV 2 ; COMMENT UPPER BOUND ESTIMATE ;
03000 SLIDEFILL:
03100 XFILLIN ← XPOSN - XLBP -(FAKE-XLBFAKE) ; COMMENT LENGTH OF PIECE ;
03200 SEGMENT ← OWL[LBO+1 TO OAKS] ; COPY(SEGMENT) ; OAKS ← LBO ; FILLER ← OLBF ;
03300 TABFILL:
03400 APPEND(FONTCHAR & "→") ; APPEND(BOUNDS) ;
03500 IF XCRIBL THEN
03600 BEGIN
03700 RKJ ; APPEND(CVSR(XFILLIN)) ;
03800 RKJ: 1-8-74 MODIFIED XGP INFINITY ; RKJ: 1-22-74 again, always need new XFILLIN ;
03900 IF INFLB<-900 THEN COMMENT FLUSH RIGHT ;
04000 XFILLIN←INFRB-XFILLIN-XLBP-(FAKE-XLBFAKE)-CHARW*LMARG
04100 ELSE COMMENT CENTER ;
04200 XFILLIN←(INFRB-INFLB-XFILLIN-(FAKE-XLBFAKE)) DIV 2 ;
04300 IF NULSTR(FILLER) THEN APPEND(CVSR(0)) ELSE
04400 APPEND(CVSR(XFILLIN DIV XLENGTH(FILLER)));
04500 TES trying 5-26-74 RKJ's above instead of my APPEND(CVSR((FILLIN*CHARW)/XLENGTH(FILLER))) ;
04600 END ;
04700 APPEND(FILLER & ALTMODE) ;
04800 APPEND(SEGMENT) ; APPEND(FONTCHAR & "←") ;
04900 POSN ← POSN + (FILLIN MAX 0) ;
05000 XPOSN ← XPOSN + (XFILLIN MAX 0) ;
05100 END "CENTER" ;
05200 COMMENT 2 ... → Right flush against TAB to RBOUND or against right margin ;
05300 BEGIN "RIGHT FLUSH"
05400 RB ← IF KIND=4 THEN RBOUND ELSE RMARG-LMARG ;
05500 FILLIN ← RB - POSN ;
05600 BOUNDS ← CVSR(INFRB←(LMARG+RB)*(IF XCRIBL THEN CHARW ELSE 1)) & CVSR(INFLB←(IF XCRIBL THEN (-CHARW*1000) ELSE -1000)) ;
05700 GO TO SLIDEFILL ;
05800 END "RIGHT FLUSH" ;
05900 END ; COMMENT BY KIND ;
06000 IF KIND=3 AND FULSTR(LBF) THEN BEGIN RBOUND ← RMARG-LMARG RKJ: 2-AUG-74 added -LMARG; ; GO TO TABCASE END ;
06100 IF KIND=4 THEN
06200 BEGIN "TAB"
06300 IF FULSTR(LBF) THEN
06400 TABCASE: BEGIN
06500 FILLIN ← RBOUND - POSN ; BOUNDS ← CVSR(LMARG+RBOUND) & CVSR(-1000) ;
06600 XFILLIN←XPOSN-XLBP; RKJ: 1-22-74 ;
06700 BOUNDS ← CVSR(INFRB←(LMARG+RBOUND)*(IF XCRIBL THEN CHARW ELSE 1)) &
06800 CVSR(INFLB←(IF XCRIBL THEN (-CHARW*1000) ELSE -1000)) ;
06900 RKJ: 1-21-74 copied above two lines, overlooked earlier ;
07000 FILLER ← LBF ; SEGMENT ← NULL ; KIND ← KIND + 2 ; GO TO TABFILL ;
07100 END
07200 ELSE APPEND(FONTCHAR&"="&CVSR(IF XCRIBL THEN CHARW*(RBOUND+LMARG) ELSE RBOUND+LMARG));
07300 BRKXPOSN←BRKXPOSN+FSHORT; FSHORT←0;
07400 POSN ← RBOUND ; XPOSN ← RBOUND * CHARW ;
07500 END "TAB" ;
07600 IF KIND > 4 THEN KIND ← KIND - 2 ; COMMENT CORRECTS `KIND←KIND+2' ABOVE ↑↑↑↑↑↑↑ ;
07700 IF KIND = 4 AND POSN > MAXIM THEN MAXIM ← NMAXIM+LMARG
07800 ELSE IF FILL THEN MAXIM ← IF KIND LEQ 2 THEN NMAXIM ELSE FMAXIM ;
07900 IF KIND = 3 THEN XLBP ← LBP ← LBO ← 0 RKJ: 1-22-74; ELSE
08000 BEGIN
08100 comment Finally, set Left Bound for a subsequent BOUND ;
08200 LBO ← OAKS ; LBP ← POSN ; XLBP ← XPOSN ; LBK ← KIND ; MIDWORD ← FALSE ;
08300 XLBFAKE ← FAKE ;
08400 CASE ((KIND+1) MAX 0) DIV 2 OF BEGIN LBF←LBF&(-KIND) ; BEGIN OLBF←LBF ; LBF←NULL END ; OLBF←LBF←NULL END ;
08500 END ;
08600 END "BOUND" ;
00100 PUBLIC SIMPLE PROCEDURE DINDENT ;$"#
00200 BEGIN
00300 STRING X ;
00400 DBREAK ; PASS ; X ← E(NULL,NULL) ; IF ON AND FULSTR(X) THEN FIRSTIM ← CVD(X) ;
00500 IF ITSCH(<,>) THEN BEGIN PASS ; X←E(NULL, NULL) END ELSE X←NULL ;
00600 IF ON AND FULSTR(X) THEN RESTIM←CVD(X) ;
00700 IF ITSCH(<,>) THEN BEGIN PASS ; X←E(NULL, NULL) END ELSE X←NULL ;
00800 IF ON AND FULSTR(X) THEN RIGHTIM←CVD(X) ;
00900 END "DINDENT" ;
00100 PUBLIC SIMPLE PROCEDURE DSUPERIMPOSE ;$"#
00200 BEGIN
00300 INTEGER N ;
00400 DBREAK ; PASS ; N ← CVD(E("0",NULL)) MIN 50 ;IF N<1 THEN N←50 ; IF NOT ON THEN RETURN ;
00500 TWEENLFM ← N-1; SINCELFM ← 0; BREAKM ← 5;
00600 END "DSUPERIMPOSE" ;
00100 PUBLIC SIMPLE PROCEDURE DTABS ;$"#
00200 BEGIN TES 8/26/74 REWROTE FOR ASCEND-CHECK AND "ONLY" OPTION ;
00300 INTEGER NUMB, I, BIG ;
00400 BIG ← 0 ;
00500 FOR I ← 1 THRU TABLIMIT DO
00600 BEGIN
00700 PASS ; NUMB ← CVD(E("-9999", NULL)) MIN 9999 ;
00800 IF ON THEN
00900 IF NUMB LEQ BIG THEN
01000 BEGIN
01100 WARN(NULL, <"TAB STOPS " & CVS(BIG) & "," & CVS(NUMB) & " ARE OUT OF ORDER">) ;
01200 I ← I - 1 ;
01300 END
01400 ELSE TABSORT[I] ← BIG ← NUMB ;
01500 IF NOT ITSCH(<,>) THEN BEGIN I ← I + 1 ; DONE END ;
01600 END ;
01700 IF ON AND I > TABLIMIT THEN WARN(NULL,"Too many Tab Stops") ;
01800 NUMB ← IF ITS(ONLY) THEN IPASS(TWO(34)) TES 8/26/73 FOR BRIAN HARVEY ;
01900 ELSE TWO(33) ;
02000 IF ON THEN TABSORT[I] ← NUMB ;
02100 END "DTABS" ;
00100 PUBLIC SIMPLE PROCEDURE SCRIPT(INTEGER ARROW) ;$"#
00200 BEGIN
00300 INTEGER CHR ;
00400 CHR ← LOP(INPUTSTR) ;
00500 HEIGHT ← HEIGHT + (IF ARROW="↑" THEN 1 ELSE -1) ;
00600 ABOVEX ← ABOVEX MAX HEIGHT ; BELOWX ← BELOWX MIN HEIGHT ;
00700 IF POSN LEQ MAXIM OR XCRIBL THEN BEGIN EMIT(NULL) ; APPEND(FONTCHAR&ARROW) ; END ;
00800 RIPTPOSNS ← RIPTPOSNS LSH 9 LOR (POSN+LMARG) ;
00900 IF LDB(SPCODE(CHR))=LBRACK THEN BEGIN SUPERSUB ← SUPERSUB LSH 9 LOR ARROW ;
01000 AMPPOSN ← AMPPOSN LSH 9 ; COMMENT 3/28/72 ; END
01100 ELSE BEGIN EMIT(CHR) ; UNSCRIPT(ARROW) END ;
01200 END "SCRIPT" ;
00100 PUBLIC RECURSIVE PROCEDURE TABTO(INTEGER POSNO) ;$"#
00200 IF ON THEN
00300 BEGIN TES 8/14/74 SIMPLIFIED AND FIXED A BUG ;
00350 POSNO ← POSNO MAX 1-LMARG ; TES 8/11/74 ;
00400 IF (IF XCRIBL THEN (POSNO*CHARW LEQ XPOSN) ELSE (POSNO LEQ POSN)) THEN
00500 IF FULSTR(LBF) THEN
00600 BEGIN
00700 WARN("=","Already passed tab column " & CVS(POSNO)) ;
00800 RETURN ;
00900 END
01000 ELSE TABI ← 0
01100 ELSE IF POSNO>NMAXIM+LMARG THEN
01200 BEGIN
01300 WARN("BAD TAB",<"Can't TAB past right margin to char "&CVS(POSNO)&
01400 (IF FILL THEN CRLF&"Did you really mean to be in FILL mode?" ELSE NULL)>) ;
01500 RETURN
01600 END ;
01700 RBOUND ← POSNO-1 ;
01800 BOUND(4) ;
01900 END "TABTO" ;
00100 PUBLIC SIMPLE PROCEDURE UNSCRIPT(INTEGER ARROW) ;$"#
00200 BEGIN
00300 INTEGER CHR, PN ; BOOLEAN MORE, WILLRIPT ;
00400 IF ARROW = 0 THEN
00500 BEGIN COMMENT "]" -- find matching "[" ;
00600 ARROW ← SUPERSUB LAND '177 ;
00700 AMPPOSN ← AMPPOSN LSH -9 ; COMMENT 3/28/72 ;
00800 SUPERSUB ← SUPERSUB LSH -9 ;
00900 END ;
01000 IF POSN LEQ MAXIM OR XCRIBL THEN
01100 BEGIN
01200 EMIT(NULL) ;
01300 IF ARROW NEQ "." THEN
01400 BEGIN
01500 APPEND(FONTCHAR & ("↑"+"↓" - ARROW)) ;
01600 HEIGHT ← HEIGHT - (IF ARROW="↑" THEN 1 ELSE -1) ;
01700 END ;
01800 END ;
01900 WILLRIPT ← TRUE ; comment assume that RIPTPOSNS will be updated by SCRIPT if necessary ;
02000 IF LDB(SPCODE(INPUTSTR)) = AMSAND THEN
02100 BEGIN
02200 LOPP(INPUTSTR) ;
02300 MORE ← TRUE ; PN ← RIPTPOSNS LAND '177 - LMARG ; COMMENT 3/28/72: ;
02400 AMPPOSN ← ((AMPPOSN LSH -9) LSH 9) LOR ((AMPPOSN LAND '177) MAX POSN) ;
02500 IF PN<POSN THEN BEGIN APPEND(FONTCHAR&"-"&CVSR(POSN-PN)) ; POSN←PN END ;
02600 IF (CHR ← LDB(SPCODE(INPUTSTR))) = LBRACK THEN
02700 BEGIN
02800 SUPERSUB ← SUPERSUB LSH 9 LOR "." ;
02900 LOPP(INPUTSTR) ; WILLRIPT ← FALSE ; comment not a ript: won't call SCRIPT! ;
03000 END
03100 ELSE IF CHR NEQ UARROW AND CHR NEQ DARROW THEN BEGIN EMIT(LOP(INPUTSTR)) ; MORE ← FALSE END ;
03200 END
03300 ELSE MORE ← FALSE ;
03400 IF NOT MORE THEN BEGIN COMMENT 3/28/72: ;
03500 PN ← (AMPPOSN LAND '177) MAX POSN ; AMPPOSN ← (AMPPOSN LSH -9) LSH 9 ;
03600 IF PN>POSN THEN BEGIN APPEND(FONTCHAR&"+"&CVSR(PN-POSN)) ; POSN←PN END END ;
03700 IF WILLRIPT THEN RIPTPOSNS ← RIPTPOSNS LSH -9 ;
03800 END "UNSCRIPT" ;
00100 FINISHED
00200
00300 ENDOF("QUADS")